home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / src / Tools / glimpsehttp / wwwlib / contrib / aglimpse.umr next >
Encoding:
Text File  |  1995-05-16  |  10.7 KB  |  434 lines

  1. #!/cc/products/prod/bin/perl
  2. #
  3. # Acknowledgements
  4. #
  5. # Thanks to Guy Brooker (guy@jw.estec.esa.nl) for his AA interface,
  6. # which was the starting point for this program.
  7. #
  8. # Paul Clark
  9. # paul@cs.arizona.edu
  10. #
  11. # Modifications
  12. #
  13. # 2/22/94    Version 1.0, shell script version    Paul Clark
  14. # 4/21/94    Version 1.1, multiple archives support    Paul Clark
  15. # 4/22/94    Version 1.2, perl script        Paul Clark
  16. # 8/05/94    Version 1.3, verbosity&security        Paul Clark
  17. #10/05/94    Version 1.4, more security, improved
  18. #                output            Paul Clark
  19. #12/15/94    -----------, support for individual
  20. #                            user archives              Nathan Neulinger
  21. #1/19/95    -----------, more security, output      Nathan Neulinger
  22. #2/2/95         -----------, improved output            Nathan Neulinger
  23. #2/3/95         -----------, changed to POST request    Nathan Neulinger
  24. #2/3/95         -----------, dumped amgr                Nathan Neulinger
  25.  
  26.  
  27. # **** **** **** ****    CONFIGURABLE VARIABLES     **** **** **** ****
  28. $GLIMPSE_LOC="/afs/umr.edu/software/glimpse/hpux/bin/glimpse" ;
  29.  
  30. # Set to use individual amgr.cfg files, instead of main dir amgr.cfg
  31. @USER_PWENT = getpwuid($>);
  32. $CONFIG_DIR = $USER_PWENT[7] . "/public_html";
  33. $USERID = $USER_PWENT[0];
  34.  
  35. $SERVER_URL = "http://www.umr.edu/~";
  36.  
  37. $BASE_URL = $SERVER_URL . $USERID;
  38. $PUBHTML_SEARCH = "/.*/public_html";
  39.  
  40.  
  41. # **** **** **** **** NO CONFIGURATION NEEDED BELOW **** **** **** ****
  42.  
  43. # Get the CGI request data
  44. &get_request;
  45.  
  46. # Get value and check to make sure archive was given
  47. $archive = $rqpairs{'archive'};
  48.  
  49. if ( $archive eq "" ) { &err_noscript; }
  50. $indexdir = $CONFIG_DIR . "/" . $archive;
  51.  
  52. # ($ENV{'HOME'} = $indexdir) || &err_noscript; # some versions of Glimpse need it
  53.  
  54. # Ensure that Glimpse is available on this machine
  55. -x $GLIMPSE_LOC || &err_noglimpse ;
  56.  
  57. # Ensure that index is available
  58. -r "$indexdir/.glimpse_index" || &err_noindex($indexdir) ;
  59.  
  60. #
  61. # Fetch values of fields and stuff from form
  62. #
  63. $QS_query = $rqpairs{'query'};
  64. $QS_caseins = $rqpairs{'case'};        
  65. $QS_whole = $rqpairs{'whole'};        
  66. $QS_errors = $rqpairs{'errors'};    
  67. $QS_maxfiles = $rqpairs{'maxfiles'};
  68. $QS_maxlines = $rqpairs{'maxlines'};
  69. $QS_showlines = $rqpairs{'showlines'};
  70. $QS_pathfilter = $rqpairs{'pathfilter'};
  71. $QS_striptags = $rqpairs{'striptags'};
  72. $QS_findtitle = $rqpairs{'findtitle'};
  73.  
  74. #
  75. # Set defaults if necessary
  76. #
  77. if ( $QS_caseins eq "" )          { $QS_caseins = "on"; }
  78. if ( $QS_whole eq "" )         { $QS_whole = "off"; }
  79. if ( $QS_errors eq "" )     { $QS_errors = "0"; }
  80. if ( $QS_showlines eq "" )     { $QS_showlines = "off"; }
  81. if ( $QS_striptags eq "" )     { $QS_striptags = "off"; }
  82. if ( $QS_findtitle eq "" )     { $QS_findtitle = "off"; }
  83.  
  84. if ($QS_maxlines =~ /\d+/) {
  85.         $maxlines = $&;
  86. } else {
  87.         $maxlines = 20;
  88. }
  89. if ($QS_maxfiles =~ /\d+/) {
  90.         $maxfiles = $&;
  91. } else {
  92.         $maxfiles = 100;
  93. }
  94.  
  95. $QS_query =~ s|\+| |g;
  96. $QS_query =~ s|%(\w\w)|sprintf("%c", hex($1))|ge;
  97. $pquery = $QS_query;
  98. $QS_query =~ s|\'|\'\"\'\"\'|g;
  99.  
  100. $OPT_errors="-$QS_errors"    if $QS_errors =~ /^[0-8]$/;
  101. $OPT_errors="-B"        if $QS_errors =~ /^Best\+match$/;
  102. $OPT_case="-i"            if $QS_caseins eq "on";
  103. $OPT_whole="-w"            if $QS_whole eq "on";
  104. $path =~ s/\./\\./;
  105. $path =~ s/\'//g;
  106. $OPT_filter="-F '$QS_pathfilter'"    if $QS_pathfilter ne "";
  107.  
  108.  
  109. $highlight = $QS_query;
  110. $highlight =~ s/^\W+//;
  111. $highlight = join("|",split(/\W+/,$highlight));
  112.  
  113. # check if the query contains any words
  114. &err_badquery if !$highlight;
  115. $highlight = '\b('.$highlight.')\b' if $OPT_whole;
  116.  
  117.  
  118. print "Content-type: text/html\n\n" ;
  119.  
  120. $TITLE = "Results of your search";
  121. $SUBTITLE = "Query: \"$pquery\"";
  122.  
  123. print "<HEAD><TITLE>$TITLE</TITLE></HEAD><BODY>\n";
  124. print "<H1>$TITLE</H1><HR>\n";
  125. print "<H2>$SUBTITLE</H2>\n";
  126. print "<UL>\n";
  127.  
  128. chdir $indexdir;
  129. $cmd = "exec $GLIMPSE_LOC -y -n $OPT_case $OPT_whole $OPT_errors -H . " .
  130.      "$OPT_filter '$QS_query' 2>&1 |";
  131. $gpid = open(GOUT, $cmd );
  132.  
  133. $prevfile = "";
  134. $lcount = 0;
  135. $fcount = 0;
  136. line: while (<GOUT>) {
  137.  
  138.     ( /^([^ :]*):\s*(\d+):(.*)/ ) || next;
  139.     $file = $1;
  140.         $line = $2;
  141.         $string = $3;
  142.  
  143.     if ( $QS_striptags eq "on" ) 
  144.     {
  145.         $string =~ s|<[^>]*>||g;
  146.     }
  147.     else
  148.     {
  149.         $string =~ s/&/\&/g;
  150.         $string =~ s/</\</g;
  151.         $string =~ s/>/\>/g;    
  152.     }
  153.     
  154.     $file_url = $file;
  155.     $file_path = $file;
  156.         $file_url =~ s:$PUBHTML_SEARCH:$BASE_URL:;
  157.  
  158.     next unless $file =~ s|$PUBHTML_SEARCH||o;
  159.     if ($file ne $prevfile) {
  160.         $linecount = 0;
  161.         if ($fcount>$maxfiles) {
  162.             print "<P></UL><LI><B>More than $maxfiles files were found.</B>\n";
  163.             $file = "";
  164.             $fcount = "at least $fcount";
  165.             $lcount = "at least $lcount";
  166.             last line;
  167.         }
  168.         print "</UL>" if ( $prevfile ne "" );
  169.         $prevfile = $file ;
  170.  
  171.         print "<BR>" if ($QS_showlines eq "on"); 
  172.         print "<LI><CODE>";
  173.         $file_title = &ExtractTitle($file_path);
  174.         if ($file_title eq "")
  175.         {
  176.             print "File Name: ";
  177.                 $file_title = $file;
  178.         }
  179.         else
  180.         {
  181.             print "File Title: ";
  182.         }
  183.          print "</CODE><A HREF=\"$file_url\">$file_title</A>\n";
  184.  
  185.  
  186.         print "<UL>\n";  # Beginning of line listing
  187.         $fcount++ ;
  188.     }
  189.     $lcount++ ;
  190.     $linecount++;
  191.  
  192.     if ($QS_showlines eq "on") 
  193.     {
  194.     
  195.         if ($linecount>=$maxlines) {
  196.             print "<LI><B>More than $maxlines line matched.\n</B>" if
  197.                     $linecount==$maxlines;
  198.             next line;
  199.         }
  200.         if ($OPT_case) {
  201.             $string =~ s#$highlight#<B>$&</B>#gio;
  202.         } else {
  203.             $string =~ s#$highlight#<B>$&</B>#go;
  204.         }
  205.  
  206.         print "<LI><CODE>Line #", $line, ": </CODE>", $string, "\n";
  207.     }
  208.  
  209. }
  210.  
  211. print "</UL>\n";
  212. print "</UL>\n" if $file ;
  213. print "<HR>" ;
  214.  
  215. print "<H2>Query \"<CODE>$QS_query</CODE>\" found ";
  216. print "$lcount matches in $fcount files</H2>\n";
  217.  
  218. print "</BODY>\n" ;
  219. close(GOUT);
  220. unlink "/tmp/.glimpse_tmp.$gpid";
  221.  
  222.  
  223. sub ExtractTitle
  224. {
  225.     local ($FILE) = @_;
  226.     local ($TITLE);
  227.    
  228.     if ( $QS_findtitle eq "on" )
  229.     {
  230.         $TEXT = `head $FILE`;
  231.         
  232.         $TEXT =~ s|<TITLE>(.*)</TITLE>||i;
  233.         $TITLE = $1;
  234.         $TITLE =~ s|<[^>]*>||g;
  235.     }
  236.  
  237.     return ($TITLE);
  238. }
  239.  
  240.  
  241.  
  242. sub diag_exit {
  243. # exit on error
  244.     exit 1;
  245. }
  246. sub err_noquery {
  247. #    The script was called without a query. 
  248. #    Provide an ISINDEX type response for browsers
  249. #    without form support.
  250.     print <<'EOM' ;
  251. Content-type: text/html
  252.  
  253. <HEAD><TITLE>Glimpse Gateway</TITLE></HEAD>
  254. <BODY><H1>Glimpse Gateway</H1>
  255.  
  256. <H2>What is Glimpse ?</H2>
  257. <QUOTE>
  258. <P>
  259. Glimpse (which stands  for  GLobal  IMPicit  SEarch)  is  an
  260. indexing  and query system that allows you to search through
  261. all your files very quickly.   For  example,  a  search  for
  262. Schwarzkopf  allowing  two  misspelling errors in 5600 files
  263. occupying 77MB took 7 seconds on a SUN  IPC.   Glimpse  supports
  264. most of agrep's options (agrep is our powerful version
  265. of  grep)  including  approximate  matching  (e.g.,  finding
  266. misspelled  words),  Boolean  queries, and even some limited
  267. forms of regular expressions.<BR>
  268. Glimpse's running time is typically slower than systems
  269. tems using inverted indexes, but its index is  an  order  of
  270. magnitude smaller (typically 2-5% of the size of the files).
  271. <H2>Authors of Glimpse</H2>
  272. Udi Manber, Sun Wu, and Burra Gopal<BR>
  273. <ADDRESS>
  274. Department of  Computer
  275. Science, University   of   Arizona,   Tucson,   AZ  85721.<BR>
  276. glimpse@cs.arizona.edu
  277. </ADDRESS>
  278. </QUOTE>
  279.  
  280. <HR>
  281. <ADDRESS>
  282. Paul Clark<BR>
  283. paul@cs.arizona.edu<BR>
  284. </ADDRESS>
  285.  
  286. </BODY>
  287. EOM
  288.     &diag_exit;
  289. }
  290.  
  291. sub err_noglimpse {
  292. #
  293. # Glimpse was not found
  294. # Report a useful message
  295. #
  296.     print <<'EOM' ;
  297. Content-type: text/html
  298.  
  299. <HEAD>
  300. <TITLE>Glimpse not found</TITLE>
  301. </HEAD>
  302. <BODY>
  303. <H1>Glimpse not found</H1>
  304.  
  305. This gateway relies on <CODE>Glimpse</CODE> search tool.
  306. If it is installed, please set the correct path in the script file.
  307. Otherwise obtain the latest version from
  308. <A HREF="file://ftp.cs.arizona.edu/glimpse">ftp.cs.arizona.edu</A>
  309. </BODY>
  310. EOM
  311.     &diag_exit;
  312. }
  313.  
  314. sub err_noindex {
  315.     local ($indexdir) = @_;
  316. # Glimpse index was not found
  317. # Give recommendations for indexing
  318.     print "Content-type: text/html\n\n";
  319.     print "<HEAD>\n";
  320.     print "<TITLE>Glimpse Index not found</TITLE>\n";
  321.     print "</HEAD>\n";
  322.     print "<BODY>\n";
  323.     print "<H1>Glimpse Index in directory '$indexdir' not found</H1>\n";
  324.     print "Glimpse cannot proceed without index.\n";
  325.     print "Please check if the directory being searched is indexed\n";
  326.     print "by <code>glimpseindex</code>.\n";
  327.     print "</BODY>\n";
  328.     &diag_exit;
  329. }
  330.  
  331. sub err_noscript {
  332. # Glimpse archive was not found
  333.     print "Content-type: text/html\n\n";
  334.     print "<HEAD>\n";
  335.     print "<TITLE>Glimpse Archive not found</TITLE>\n";
  336.     print "</HEAD>\n";
  337.     print "<BODY>\n";
  338.     print "<H1>Glimpse Archive not found</H1>\n";
  339.     print "Cannot find script \"$script\" in config file ".
  340.         "$AMGR_CFG_LOC\n";
  341.     print "</BODY>\n";
  342.     &diag_exit;
  343. }
  344.  
  345. #sub err_conf {
  346. ## Glimpse archive Configuration File was not found
  347. #    print "Content-type: text/html\n\n";
  348. #    #print "<HEAD>\n";
  349. #    print "<TITLE>Glimpse Archive Configuration File not found</TITLE>\n";
  350. #    print "</HEAD>\n";
  351. #    print "<BODY>\n";
  352. #    print "<H1>Glimpse Archive Configuration File not found</H1>\n";
  353. #    print "Cannot open configuration file $AMGR_CFG_LOC\n";
  354. #    print "</BODY>\n";
  355. #    &diag_exit;
  356. #}
  357.  
  358. sub err_badquery {
  359.     print "Content-type: text/html\n\n";
  360.     print "<HEAD>\n";
  361.     print "<TITLE>Query is too broad</TITLE>\n";
  362.     print "</HEAD>\n";
  363.     print "<BODY>\n";
  364.     print "<H1>Query is too broad</H1>\n";
  365.     print "The query \"$pquery\" doesn't contain any words and ".
  366.         "thus will take too much time. Please refine your query.\n";
  367.     print "</BODY>\n";
  368.     &diag_exit;
  369. }
  370.  
  371.  
  372.  
  373.  
  374.  
  375.  
  376. #############################################################################
  377. #
  378. # The following routines are for handling cgi requests
  379. #
  380.  
  381.  
  382. # Author:
  383. #     James Tappin: sjt@xun8.sr.bham.ac.uk
  384. #    School of Physics & Space Research University of Birmingham
  385. #    Feb 1993.        
  386.  
  387. # Copyright & Disclaimer.
  388. #    This set of routines may be freely distributed, modified and
  389. #    used, provided this copyright & disclaimer remains intact.
  390. #    This package is used at your own risk, if it does what you
  391. #    want, good; if it doesn't, modify it or use something else--but
  392. #    don't blame me. Support level = negligable (i.e. mail bugs but
  393. #    not requests for extensions)
  394.  
  395. sub get_request {
  396.  
  397.     # Subroutine get_request reads the POST or GET form request from STDIN
  398.     # into the variable  $request, and then splits it into its
  399.     # name=value pairs in the associative array %rqpairs.
  400.     # The number of bytes is given in the environment variable
  401.     # CONTENT_LENGTH which is automatically set by the request generator.
  402.  
  403.     # Encoded HEX values and spaces are decoded in the values at this
  404.     # stage.
  405.  
  406.     # $request will contain the RAW request. N.B. spaces and other
  407.     # special characters are not handler in the name field.
  408.  
  409.     if ($ENV{'REQUEST_METHOD'} eq "POST") {
  410.     read(STDIN, $request, $ENV{'CONTENT_LENGTH'});
  411.     } elsif ($ENV{'REQUEST_METHOD'} eq "GET" ) {
  412.     $request = $ENV{'QUERY_STRING'};
  413.     }
  414.  
  415.     %rqpairs = &url_decode(split(/[&=]/, $request));
  416. }
  417.  
  418. sub url_decode {
  419.  
  420. #    Decode a URL encoded string or array of strings 
  421. #        + -> space
  422. #        %xx -> character xx
  423.  
  424.     foreach (@_) {
  425.     tr/+/ /;
  426.     s/%(..)/pack("c",hex($1))/ge;
  427.     }
  428.     @_;
  429. }
  430.  
  431.  
  432.  
  433.  
  434.